home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops ƒ / PathsMod.txt < prev    next >
Text File  |  1993-02-20  |  2KB  |  73 lines
  1. \ We call this module if a list of HFS path designators is to be used to
  2. \ find a file.  First we grab the file with the list
  3. \ of path designators (one per line).  For each designator we prepend
  4. \ it to the given filename, and attempt to open the file.  We keep
  5. \ going until either the open succeeds or we run out of path designators.
  6. \ If the open succeeds we leave the name in the fcb set to the full
  7. \ path name.  If the open fails we restore the name to what it was.
  8.  
  9. objPtr        PATHS_F    class_is  file
  10. objHandle        PATHS_HDL
  11.  
  12. string    NAME
  13. string    FULLNAME
  14. string    PDS
  15.  
  16. local    OWP  { fcb mode \ ret? -- rc }
  17.  
  18. : OPENLOOP
  19.     BEGIN              \ Loop over path designators
  20.         len: pds
  21.         NIF                    \ Not found
  22.             all: name  fcb name: file    \ Restore orig name
  23.             FNF  EXIT
  24.         THEN
  25.         RET  chsearch: pds  -> ret?
  26.         pds ->: fullName  name  $add: fullName
  27.         all: fullName  fcb name: file
  28.         fcb mode (open)  NIF  0  EXIT  THEN    \ Found
  29.         step: pds  ret? negate skip: pds
  30.     AGAIN  ;
  31.  
  32.  
  33. :loc OWP
  34.     reset: pds
  35.     len: pds  NIF  FNF  EXIT  THEN
  36.             \ If no paths, we return a "file not found" error.
  37.     fcb  getName: file  put: name  new: fullName
  38.     openLoop
  39.     release: name  release: fullName  ;loc
  40.  
  41.  
  42. : GETPATHS    \ ( addr len -- )
  43.     true -> use_paths?        \ This becomes the default now
  44.                     \  that GETPATHS has been called
  45.     keep: pathsMod
  46.     nil?: pds  IF  new: pds  ELSE  clear: pds  THEN
  47.     release: paths_hdl  ['] file  newObj: paths_hdl
  48.     obj: paths_hdl  -> paths_f
  49.     name: paths_f  openReadOnly: paths_f
  50.     IF
  51.         msg# 133        \ Warning - couldn't find paths file
  52.         release: paths_hdl  nilP -> paths_f  EXIT
  53.     THEN
  54.     size: paths_f  setsize: pds
  55.     all: pds  read: paths_f  drop
  56.     close: paths_f  drop  releaseObj: paths_hdl  ;
  57.  
  58.  
  59. : .PATHS  { \ ret? -- }
  60.     nil?: pds  ?EXIT
  61.     reset: pds
  62.     BEGIN
  63.         len: pds  0EXIT
  64.         RET  chsearch: pds  -> ret?
  65.         get: pds  type  cr
  66.         step: pds  ret? negate skip: pds
  67.     AGAIN  ;
  68.  
  69.  
  70. : REL    release: pds  ;
  71.  
  72. ' rel  setRelease
  73.